home *** CD-ROM | disk | FTP | other *** search
/ Aminet 40 / Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso / Aminet / misc / emu / ATUtilities.lha / ATUtilities / M2 / GDOS.MOD < prev    next >
Text File  |  2000-09-26  |  22KB  |  736 lines
  1. (*$S- *)
  2. MODULE GDOS;
  3.  
  4. FROM SYSTEM  IMPORT ASSEMBLER,BYTE,WORD,ADDRESS,ADR,OFS,SEG,SEGMENT,OFFSET;
  5. FROM Storage IMPORT ALLOCATE,DEALLOCATE;
  6. FROM Strings IMPORT Length,Copy;
  7. FROM System  IMPORT AX,BX,CX,DX,ES,DS,SI,DI,Trap,XTrap,Move,SetVector,GetVector,
  8.                     TermProcedure,Terminate,InstallRTErrorHandler,
  9.                     UninstallRTErrorHandler;
  10. FROM InOut   IMPORT WriteString,WriteCard,WriteHex,WriteLn;
  11. FROM VGA     IMPORT CopyVideo2Buffer,CopyBuffer2Video,SetRGB,DrawBorder,PutText,
  12.                     CheckVGA,ClearVideo,DrawX;
  13. FROM Mouse   IMPORT MouseOn,MouseOff,CheckMouse,WaitForKey,GetMouseData,
  14.                     WaitForClick;
  15. FROM GEM     IMPORT InstallGDOSVector,RemoveGDOSVector,GDOS,GDOSPtr,gdos;
  16. FROM DOS     IMPORT OpenTemporaryFile,CloseTemporaryFile,ReadFile,
  17.                     WriteFile,SeekFile,offsetBeginning,FileHandlePtr;
  18. FROM GEM     IMPORT Window,WindowPtr,WindowFlags,WindowFlagSet,SystemMessagePtr,
  19.                     MessageClasses,MessageClassSet,MouseButtons,MouseButtonSet,
  20.                     STRING,GadgetTypes,GadgetTypeSet,Gadget,GadgetPtr,Menu,MenuPtr;
  21.  
  22. VAR bool    : BOOLEAN;
  23.     a,b     : CARDINAL;
  24.     c,d     : LONGCARD;
  25.     titel   : ARRAY [0..30] OF ARRAY [0..79] OF CHAR;
  26.     msg     : SystemMessagePtr;
  27.     w1,w2,w3,w4,w5 : WindowPtr;
  28.     m1 : MenuPtr;
  29.  
  30. PROCEDURE Crash(text : ARRAY OF CHAR);
  31. VAR l,x : CARDINAL;
  32.     tex : ARRAY [0..79] OF CHAR;
  33. BEGIN
  34.  tex := "NICHT BEHEBBARER FEHLER BEI DER PROGRAMMAUSFšHRUNG";
  35.  
  36.  IF (gdos = NIL) THEN
  37.   WriteString(tex);
  38.   WriteLn;
  39.   WriteString(text);
  40.   WriteLn;
  41.   WriteLn;
  42.  ELSE
  43.   ClearVideo(40,128,560,112);
  44.   DrawBorder(15,1,40,128,560,112);
  45.   PutText(14,(80-Length(tex)) DIV 2,10,ADR(tex));
  46.   Copy(text,0,Length(text),tex);
  47.   PutText(14,(80-Length(tex)) DIV 2,12,ADR(tex));
  48.   WaitForKey;
  49.  END (* IF *);
  50.  Terminate(0);
  51. END Crash;
  52.  
  53. (* ----------- Hauptprogramm ------------------ *)
  54.  
  55. PROCEDURE RTErrorHandler(fehler : CARDINAL; adresse : ADDRESS);
  56. VAR w : WindowPtr;
  57. BEGIN
  58.  IF (gdos # NIL) THEN RemoveGDOSVector(); END;
  59.  WriteString("NICHT BEHEBBARER FEHLER BEI DER PROGRAMMAUSFšHRUNG!");
  60.  WriteLn;
  61.  WriteString("Abbruch durch Modula-2 RunTime-Fehler #");
  62.  WriteCard(fehler,1);
  63.  WriteLn;
  64.  WriteLn;
  65. END RTErrorHandler;
  66.  
  67. PROCEDURE Terminator;
  68. BEGIN
  69.  IF (gdos # NIL) THEN RemoveGDOSVector(); END;
  70.  WriteString("bye!");
  71.  WriteLn;
  72. END Terminator;
  73.  
  74.  
  75.  
  76. PROCEDURE AddBoolGadget(win     : WindowPtr;
  77.                         x,y,w,h : CARDINAL;
  78.                         text    : STRING;
  79.                         id      : CARDINAL);
  80. VAR gad : GadgetPtr;
  81. BEGIN
  82.  ALLOCATE(gad,SIZE(Gadget));
  83.  IF (gad=NIL) THEN
  84.   Crash("Nicht genug Speicher fr Bildschirmelemente!");
  85.  END (* IF *);
  86.  gad^.nextGadget  := win^.firstGadget;
  87.  gad^.leftEdge    := x;
  88.  gad^.topEdge     := y;
  89.  gad^.width       := w;
  90.  gad^.height      := h;
  91.  gad^.x1          := x*8;
  92.  gad^.y1          := y*16;
  93.  gad^.w           := w*8;
  94.  gad^.h           := h*16;
  95.  gad^.x2          := gad^.x1+gad^.w;
  96.  gad^.y2          := gad^.y1+gad^.h;
  97.  gad^.type        := GadgetTypeSet{boolean};
  98.  gad^.text        := text;
  99.  gad^.id          := id;
  100.  win^.firstGadget := gad;
  101.  PutText(3,win^.leftEdge+gad^.leftEdge+1,win^.topEdge+gad^.topEdge,text);
  102.  DrawBorder(15,1,win^.x1+gad^.x1,win^.y1+gad^.y1,gad^.w,gad^.h);
  103. END AddBoolGadget;
  104.  
  105. PROCEDURE AddMinGadget(win       : WindowPtr;
  106.                        x1,y1,w,h : CARDINAL;
  107.                        type      : GadgetTypeSet;
  108.                        id        : CARDINAL) : GadgetPtr;
  109. VAR gad : GadgetPtr;
  110. BEGIN
  111.  ALLOCATE(gad,SIZE(Gadget));
  112.  IF (gad=NIL) THEN
  113.   Crash("Nicht genug Speicher fr Bildschirmelemente!");
  114.  END (* IF *);
  115.  gad^.nextGadget  := win^.firstGadget;
  116.  gad^.x1          := x1;
  117.  gad^.y1          := y1;
  118.  gad^.w           := w;
  119.  gad^.h           := h;
  120.  gad^.x2          := x1+w;
  121.  gad^.y2          := y1+h;
  122.  gad^.type        := type;
  123.  gad^.text        := NIL;
  124.  gad^.id          := id;
  125.  win^.firstGadget := gad;
  126.  RETURN(gad);
  127. END AddMinGadget;
  128.  
  129. PROCEDURE AddMenu(win     : WindowPtr;
  130.                   x,w     : CARDINAL;
  131.                   text    : STRING;
  132.                   enabled : BOOLEAN) : MenuPtr;
  133. VAR gad  : GadgetPtr;
  134.     menu : MenuPtr;
  135.     l    : CARDINAL;
  136. BEGIN
  137.  ALLOCATE(menu,SIZE(Menu));
  138.  IF (menu=NIL) THEN
  139.   Crash("Nicht genug Speicher fr Men!");
  140.  END (* IF *);
  141.  l := Length(text^);
  142.  menu^.nextMenu  := win^.firstMenu;
  143.  menu^.text      := text;
  144.  menu^.enabled   := enabled;
  145.  menu^.mx1       := x*8;
  146.  menu^.mx2       := (x+l)*8;
  147.  menu^.leftEdge  := x;
  148.  menu^.width     := w;
  149.  menu^.x1        := x*8;
  150.  menu^.x2        := (x+w)*8;
  151.  menu^.itemCount := 0;
  152.  win^.firstMenu  := menu;
  153.  PutText(5,x,1,text);
  154.  RETURN(menu);
  155. END AddMenu;
  156.  
  157. PROCEDURE AddItem(menu    : MenuPtr;
  158.                   text    : STRING;
  159.                   checkit : BOOLEAN;
  160.                   checked : BOOLEAN;
  161.                   enabled : BOOLEAN);
  162. BEGIN
  163.  IF (menu^.itemCount=24) THEN
  164.   Crash("AddItem(): Mehr als 25 Items in einem Men!");
  165.  END (* IF *);
  166.  menu^.items[menu^.itemCount].text := text;
  167.  menu^.items[menu^.itemCount].checked := checked;
  168.  menu^.items[menu^.itemCount].checkit := checkit;
  169.  menu^.items[menu^.itemCount].enabled := enabled;
  170.  menu^.itemCount := menu^.itemCount + 1;
  171. END AddItem;
  172.  
  173. PROCEDURE SetTitleColor(win : WindowPtr; bool : BOOLEAN);
  174. VAR farbe : CARDINAL;
  175. BEGIN
  176.  MouseOff();
  177.  IF (win^.lock=TRUE) THEN bool := FALSE; END;
  178.  IF (bool=TRUE) THEN farbe := 9; ELSE farbe := 10; END;
  179.  IF (win # NIL) THEN
  180.   IF NOT (borderless IN win^.flags) THEN
  181.    IF NOT (windowClose IN win^.flags) THEN
  182.     PutText(farbe,win^.leftEdge+1,win^.topEdge,win^.title);
  183.    ELSE
  184.     PutText(farbe,win^.leftEdge+3,win^.topEdge,win^.title);
  185.    END (* IF *);
  186.    DrawBorder(15,1,win^.x1,win^.y1,win^.w-1,16);
  187.   END (* IF *);
  188.  END (* IF *);
  189.  MouseOn();
  190. END SetTitleColor;
  191.  
  192. PROCEDURE RestoreWindow(win : WindowPtr);
  193. VAR long          : LONGCARD;
  194.     size,i,y,h,h2 : CARDINAL;
  195. BEGIN
  196.  MouseOff();
  197.  long := LONG(win^.w)*LONG(win^.h) DIV 2L;
  198.  IF (memSwap IN win^.flags) AND (long<=65000L) THEN
  199.   IF (win^.swapMem # NIL) THEN
  200.    CopyBuffer2Video(win^.swapMem,win^.x1,win^.y1,win^.w,win^.h);
  201.   END (* IF *);
  202.  ELSE
  203.   IF (win^.swapFile # NIL) THEN
  204.    IF (long>65000L) THEN
  205.     y := win^.y1;
  206.     h := win^.h;
  207.     WHILE (h>0) DO
  208.      h2 := h;
  209.      IF h2>100 THEN h2 := 50; END;
  210.      h := h - h2;
  211.      size := win^.w * (h2 DIV 2);
  212.      i := ReadFile(win^.swapFile,gdos^.graphics64,size);
  213.      CopyBuffer2Video(gdos^.graphics64,win^.x1,y,win^.w,h2);
  214.      y := y + h2;
  215.     END (* WHILE *);
  216.    ELSE
  217.     size := SHORT(long);
  218.     i := ReadFile(win^.swapFile,gdos^.graphics64,size);
  219.     CopyBuffer2Video(gdos^.graphics64,win^.x1,win^.y1,win^.w,win^.h) ;
  220.    END (* IF *);
  221.   END (* IF *);
  222.   SeekFile(win^.swapFile,0L,offsetBeginning);
  223.  END (* IF *);
  224.  MouseOn();
  225. END RestoreWindow;
  226.  
  227. PROCEDURE BackupWindow(win : WindowPtr);
  228. VAR long          : LONGCARD;
  229.     size,i,y,h,h2 : CARDINAL;
  230. BEGIN
  231.  MouseOff();
  232.  long := LONG(win^.w)*LONG(win^.h) DIV 2L;
  233.  IF (memSwap IN win^.flags) AND (long<=65000L) THEN
  234.   size := SHORT(long);
  235.   IF (win^.swapMem=NIL) THEN
  236.    ALLOCATE(win^.swapMem,size);
  237.    IF (win^.swapMem=NIL) THEN
  238.     Crash("Nicht genug Speicher zur Grafikauslagerung!");
  239.    END (* IF *);
  240.   END (* IF *);
  241.   win^.swapSize := size;
  242.   CopyVideo2Buffer(win^.swapMem,win^.x1,win^.y1,win^.w,win^.h);
  243.  ELSE
  244.   IF (win^.swapFile=NIL) THEN win^.swapFile := OpenTemporaryFile(); END;
  245.   IF (win^.swapFile # NIL) THEN
  246.    IF (long>65000L) THEN
  247.     y := win^.y1;
  248.     h := win^.h;
  249.     WHILE (h>0) DO
  250.      h2 := h;
  251.      IF h2>100 THEN h2 := 50; END;
  252.      h := h - h2;
  253.      size := win^.w * (h2 DIV 2);
  254.      CopyVideo2Buffer(gdos^.graphics64,win^.x1,y,win^.w,h2);
  255.      i := WriteFile(win^.swapFile,gdos^.graphics64,size);
  256.      y := y + h2;
  257.     END (* WHILE *);
  258.    ELSE
  259.     size := SHORT(long);
  260.     CopyVideo2Buffer(gdos^.graphics64,win^.x1,win^.y1,win^.w,win^.h);
  261.     i := WriteFile(win^.swapFile,gdos^.graphics64,size);
  262.    END (* IF *);
  263.    SeekFile(win^.swapFile,0L,offsetBeginning);
  264.   ELSE
  265.    Crash("Erstellung von tempor„ren Dateien nicht m”glich!");
  266.   END (* IF *);
  267.  END (* IF *);
  268.  MouseOn();
  269. END BackupWindow;
  270.  
  271. PROCEDURE ClearWindow(win : WindowPtr);
  272. VAR long    : LONGCARD;
  273.     z,h1,h2 : CARDINAL;
  274. BEGIN
  275.  long := LONG(win^.w)*LONG(win^.h) DIV 2L;
  276.  MouseOff();
  277.  IF (long>65000L) THEN
  278.   z := win^.y1;
  279.   h1 := win^.h;
  280.   WHILE (h1>0) DO
  281.    h2 := h1;
  282.    IF h2>100 THEN h2 := 50; END;
  283.    h1 := h1 - h2;
  284.    ClearVideo(win^.x1,z,win^.w,h2);
  285.    z := z + h2;
  286.   END (* WHILE *);
  287.  ELSE
  288.   ClearVideo(win^.x1,win^.y1,win^.w,win^.h);
  289.  END (* IF *);
  290.  MouseOn();
  291. END ClearWindow;
  292.  
  293. PROCEDURE RestoreVideo(win : WindowPtr);
  294. VAR w2 : WindowPtr;
  295. BEGIN
  296.  w2 := win^.nextWindow;
  297.  IF (w2 # NIL) THEN RestoreVideo(w2); END;
  298.  RestoreWindow(win);
  299. END RestoreVideo;
  300.  
  301. PROCEDURE InactivateWindow(win : WindowPtr);
  302. VAR long          : LONGCARD;
  303.     size,i,y,h,h2 : CARDINAL;
  304. BEGIN
  305.  MouseOff();
  306.  ClearVideo(8,16,624,16);
  307.  SetTitleColor(win,FALSE);
  308.  BackupWindow(win);
  309.  MouseOn();
  310. END InactivateWindow;
  311.  
  312. PROCEDURE ActivateWindow(win : WindowPtr);
  313. VAR w2   : WindowPtr;
  314.     menu : MenuPtr;
  315. BEGIN
  316.  MouseOff();
  317.  IF NOT (win=gdos^.firstWindow) THEN
  318.   InactivateWindow(gdos^.firstWindow);
  319.   RestoreWindow(win);
  320.   SetTitleColor(win,TRUE);
  321.   w2 := gdos^.firstWindow;
  322.   WHILE (w2^.nextWindow<>win) DO
  323.    w2 := w2^.nextWindow;
  324.   END (* WHILE *);
  325.   w2^.nextWindow := win^.nextWindow;
  326.   win^.nextWindow := gdos^.firstWindow;
  327.   gdos^.firstWindow := win;
  328.   menu := win^.firstMenu;
  329.   WHILE (menu # NIL) DO
  330.    PutText(5,menu^.leftEdge,1,menu^.text);
  331.    menu := menu^.nextMenu;
  332.   END (* WHILE *);
  333.  END (* IF *);
  334.  MouseOn();
  335. END ActivateWindow;
  336.  
  337. PROCEDURE OpenWindow(title   : STRING;
  338.                      x,y,w,h : CARDINAL;
  339.                      flags   : WindowFlagSet) : WindowPtr;
  340. VAR win : WindowPtr;
  341.     gad : GadgetPtr;
  342. BEGIN
  343.  ALLOCATE(win,SIZE(Window));
  344.  IF (win=NIL) THEN
  345.   Crash("OpenWindow(): Nicht genug Speicher fr neues Fenster!");
  346.  END (* IF *);
  347.  win^.nextWindow   := gdos^.firstWindow;
  348.  win^.leftEdge     := x;
  349.  win^.topEdge      := y;
  350.  win^.width        := w;
  351.  win^.height       := h;
  352.  win^.x1           := x*8;
  353.  win^.y1           := y*16;
  354.  win^.w            := w*8;
  355.  win^.h            := h*16;
  356.  win^.x2           := win^.x1+win^.w;
  357.  win^.y2           := win^.y1+win^.h;
  358.  win^.firstGadget  := NIL;
  359.  win^.firstMenu    := NIL;
  360.  win^.title        := title;
  361.  win^.flags        := flags;
  362.  win^.swapFile     := NIL;
  363.  win^.swapMem      := NIL;
  364.  win^.swapSize     := 0;
  365.  win^.lock         := FALSE;
  366.  IF (gdos^.firstWindow # NIL) THEN InactivateWindow(gdos^.firstWindow); END;
  367.  gdos^.firstWindow := win;
  368.  MouseOff();
  369.  ClearWindow(win);
  370.  IF (windowClose IN flags) THEN
  371.   DrawBorder(15,1,win^.x1,win^.y1,16,16);
  372.   DrawBorder(15,1,win^.x1+4,win^.y1+4,8,8);
  373.   gad := AddMinGadget(win,0,0,16,16,GadgetTypeSet{systemClose},0);
  374.  END (* IF *);
  375.  IF (windowDepth IN flags) THEN
  376.   DrawBorder(15,1,win^.x2-17,win^.y1,16,16);
  377.   DrawBorder(1,15,win^.x2-12,win^.y1+4,8,8);
  378.   DrawBorder(15,1,win^.x2-14,win^.y1+2,8,8);
  379.   gad := AddMinGadget(win,win^.w-17,0,16,16,GadgetTypeSet{systemDepth},0);
  380.  END (* IF *);
  381.  SetTitleColor(win,TRUE);
  382.  DrawBorder(15,1,win^.x1,win^.y1,win^.w-1,win^.h-1);
  383.  MouseOn();
  384.  RETURN(win);
  385. END OpenWindow;
  386.  
  387. PROCEDURE CloseWindow(win : WindowPtr);
  388. VAR w2 : WindowPtr;
  389. BEGIN
  390.  w2 := gdos^.firstWindow;
  391.  IF NOT (w2=win) THEN
  392.   BackupWindow(w2);
  393.   WHILE NOT (w2^.nextWindow=win) DO
  394.    w2 := w2^.nextWindow;
  395.   END (* WHILE *);
  396.   w2^.nextWindow := win^.nextWindow;
  397.  ELSE
  398.   gdos^.firstWindow := win^.nextWindow;
  399.  END (* IF *);
  400.  
  401.  IF (win^.swapFile # NIL) THEN
  402.   CloseTemporaryFile(win^.swapFile);
  403.  END (* IF *);
  404.  IF (win^.swapMem # NIL) THEN
  405.   DEALLOCATE(win^.swapMem,win^.swapSize);
  406.  END (* IF *);
  407.  ClearWindow(win);
  408.  IF (gdos^.firstWindow # NIL) THEN
  409.   RestoreVideo(gdos^.firstWindow);
  410.   SetTitleColor(gdos^.firstWindow,TRUE);
  411.  END (* IF *);
  412.  
  413.  DEALLOCATE(win,SIZE(Window));
  414. END CloseWindow;
  415.  
  416. PROCEDURE LockWindow(win : WindowPtr);
  417. BEGIN
  418.  win^.lock := TRUE;
  419.  SetTitleColor(win,FALSE);
  420. END LockWindow;
  421.  
  422. PROCEDURE UnlockWindow(win : WindowPtr);
  423. BEGIN
  424.  win^.lock := FALSE;
  425. END UnlockWindow;
  426.  
  427. PROCEDURE GetWindowPtr(x,y : CARDINAL) : WindowPtr;
  428. VAR win : WindowPtr;
  429. BEGIN
  430.  win := gdos^.firstWindow;
  431.  IF y<33 THEN RETURN(win); END;
  432.  WHILE (win # NIL) DO
  433.   IF (x>=win^.x1) AND (y>=win^.y1) AND (x<=win^.x2) AND (y<=win^.y2) THEN
  434.    RETURN(win);
  435.   END (* IF *);
  436.   win := win^.nextWindow;
  437.  END (* WHILE *);
  438.  RETURN(NIL);
  439. END GetWindowPtr;
  440.  
  441. PROCEDURE OpenMenu(menu : MenuPtr; ptr : SystemMessagePtr) : BOOLEAN;
  442. VAR w,h,i,
  443.     oy,x,y  : CARDINAL;
  444.     bool    : BOOLEAN;
  445.     chkmark : ARRAY [0..3] OF CHAR;
  446. BEGIN
  447.  IF (menu^.itemCount=0) THEN RETURN(FALSE); END;
  448.  bool := FALSE;
  449.  chkmark := 373C;
  450.  MouseOff();
  451.  PutText(14,menu^.leftEdge,1,menu^.text);
  452.  w := menu^.width*8;
  453.  h := menu^.itemCount*16+16;
  454.  CopyVideo2Buffer(gdos^.graphics64,menu^.x1,24,w,h);
  455.  ClearVideo(menu^.x1,24,w,h);
  456.  DrawBorder(15,1,menu^.x1,25,w-1,h-2);
  457.  FOR i := 0 TO menu^.itemCount-1 DO
  458.   IF (menu^.items[i].text # NIL) THEN
  459.    IF (menu^.items[i].enabled=FALSE) THEN
  460.     oy := 3;
  461.    ELSE
  462.     oy := 5;
  463.    END (* IF *);
  464.    PutText(oy,menu^.leftEdge+1,i+2,menu^.items[i].text);
  465.    IF (menu^.items[i].checked=TRUE) THEN
  466.     PutText(6,(menu^.leftEdge+menu^.width-2),i+2,ADR(chkmark));
  467.    END (* IF *);
  468.   ELSE
  469.    DrawX(15,menu^.x1+1,((2+i)*16+8),menu^.x2-3);
  470.   END (* IF *);
  471.  END (* FOR *);
  472.  MouseOn();
  473.  oy := 0FFFFH;
  474.  REPEAT
  475.   GetMouseData(ptr);
  476.   x := ptr^.mouseX DIV 8;
  477.   y := ptr^.mouseY DIV 16;
  478.   IF NOT (oy=y) THEN
  479.    IF NOT (oy=0FFFFH) THEN
  480.     MouseOff();
  481.     PutText(5,menu^.leftEdge+1,oy,menu^.items[oy-2].text);
  482.     MouseOn();
  483.     oy := 0FFFFH;
  484.    END (* IF *);
  485.    IF (x>=menu^.leftEdge) AND (x<=(menu^.leftEdge+menu^.width)) THEN
  486.     IF (y>=2) AND (y<=menu^.itemCount+2) THEN
  487.      IF (menu^.items[y-2].text # NIL) AND (menu^.items[y-2].enabled=TRUE) THEN
  488.       MouseOff();
  489.       PutText(14,menu^.leftEdge+1,y,menu^.items[y-2].text);
  490.       MouseOn();
  491.       oy := y;
  492.      END (* IF *);
  493.     END (* IF *);
  494.    END (* IF *);
  495.   END (* IF *);
  496.  UNTIL (left IN ptr^.mouseButtons);
  497.  REPEAT
  498.   GetMouseData(ptr);
  499.  UNTIL NOT (left IN ptr^.mouseButtons);
  500.  IF NOT (oy=0FFFFH) THEN
  501.   bool := TRUE;
  502.   ptr^.itemNum := oy-2;
  503.   IF (menu^.items[ptr^.itemNum].checkit=TRUE) THEN
  504.    IF (menu^.items[ptr^.itemNum].checked=TRUE) THEN
  505.     menu^.items[ptr^.itemNum].checked := FALSE;
  506.    ELSE
  507.     menu^.items[ptr^.itemNum].checked := TRUE;
  508.    END (* IF *);
  509.   END (* IF *);
  510.  END (* IF *);
  511.  MouseOff();
  512.  CopyBuffer2Video(gdos^.graphics64,menu^.x1,24,w,h);
  513.  PutText(5,menu^.leftEdge,1,menu^.text);
  514.  MouseOn();
  515.  RETURN(bool);
  516. END OpenMenu;
  517.  
  518. PROCEDURE DesktopManager(class : MessageClassSet) : SystemMessagePtr;
  519. VAR ptr   : SystemMessagePtr;
  520.     win   : WindowPtr;
  521.     gad   : GadgetPtr;
  522.     menu  : MenuPtr;
  523.     bool  : BOOLEAN;
  524. BEGIN
  525.  bool := FALSE;
  526.  REPEAT
  527.   ptr := gdos^.systemMessage;
  528.   GetMouseData(ptr);
  529.   ptr^.window := gdos^.firstWindow;
  530.   IF (ptr=NIL) THEN
  531.    ptr^.class  := MessageClassSet{noWindow};
  532.    ptr^.window := NIL;
  533.    RETURN(ptr);
  534.   END (* IF *);
  535.  
  536.   IF (left IN ptr^.mouseButtons) THEN
  537.    win := GetWindowPtr(ptr^.mouseX,ptr^.mouseY);
  538.    IF (win # NIL) THEN
  539.     ptr^.window := win;
  540.     IF (win<>gdos^.firstWindow) THEN
  541.      ActivateWindow(win);
  542.      IF (win^.lock=FALSE) THEN
  543.       IF (activateWindow IN class) THEN
  544.        bool := TRUE;
  545.        ptr^.class := MessageClassSet{activateWindow};
  546.       END (* IF *);
  547.      END (* IF *);
  548.     ELSE
  549.      IF (win^.lock=FALSE) THEN
  550.       IF (ptr^.mouseY>32) THEN
  551.        gad := win^.firstGadget;
  552.        WHILE (gad # NIL) DO
  553.         IF (ptr^.mouseX>=win^.x1+gad^.x1) AND (ptr^.mouseY>=win^.y1+gad^.y1) AND (ptr^.mouseX<=win^.x1+gad^.x2) AND (ptr^.mouseY<=win^.y1+gad^.y2) THEN
  554.          IF NOT (gadBorderless IN gad^.type) THEN
  555.           MouseOff();
  556.           DrawBorder(1,15,win^.x1+gad^.x1,win^.y1+gad^.y1,gad^.w,gad^.h);
  557.           MouseOn();
  558.           REPEAT
  559.            GetMouseData(ptr);
  560.           UNTIL NOT (left IN ptr^.mouseButtons);
  561.           MouseOff();
  562.           DrawBorder(15,1,win^.x1+gad^.x1,win^.y1+gad^.y1,gad^.w,gad^.h);
  563.           MouseOn();
  564.          END (* IF *);
  565.          IF (ptr^.mouseX>=win^.x1+gad^.x1) AND (ptr^.mouseY>=win^.y1+gad^.y1) AND (ptr^.mouseX<=win^.x1+gad^.x2) AND (ptr^.mouseY<=win^.y1+gad^.y2) THEN
  566.           ptr^.gadget := gad;
  567.           IF (systemClose IN gad^.type) THEN
  568.            bool := TRUE;
  569.            ptr^.class := MessageClassSet{closeWindow};
  570. (*
  571.           ELSE IF (systemDepth IN gad^.type) THEN
  572. *)
  573.           ELSE
  574.            bool := TRUE;
  575.            ptr^.class := MessageClassSet{gadgetUp};
  576.           END (* IF *);
  577.          END (* IF *);
  578.          gad := NIL;
  579.         ELSE
  580.          gad := gad^.nextGadget
  581.         END (* IF *);
  582.        END (* WHILE *);
  583.       ELSE
  584.        IF (ptr^.mouseY>15) THEN
  585.         menu := win^.firstMenu;
  586.         ptr^.menuNum := 0;
  587.         ptr^.class   := MessageClassSet{menuPick};
  588.         WHILE (menu # NIL) DO
  589.          IF (ptr^.mouseX>=menu^.mx1) AND (ptr^.mouseX<=menu^.mx2) THEN
  590.           IF (menu^.enabled=TRUE) THEN
  591.            REPEAT
  592.             GetMouseData(ptr);
  593.            UNTIL NOT (left IN ptr^.mouseButtons);
  594.            bool := OpenMenu(menu,ptr);
  595.           END (* IF *);
  596.           menu := NIL;
  597.          ELSE
  598.           menu := menu^.nextMenu;
  599.           ptr^.menuNum := ptr^.menuNum + 1;
  600.          END (* IF *);
  601.         END (* WHILE *);
  602.        END (* IF *);
  603.       END (* IF *);
  604.      END (* IF *);
  605.     END (* IF *);
  606.    END (* IF *);
  607.   END (* IF *);
  608.  UNTIL (bool=TRUE);
  609.  RETURN(ptr);
  610. END DesktopManager;
  611.  
  612. BEGIN
  613.  bool := CheckVGA();
  614.  IF (bool=FALSE) THEN
  615.   Crash("Dieses Programm ben”tigt eine VGA-Grafikkarte!");
  616.  END (* IF *);
  617.  bool := CheckMouse();
  618.  IF (bool=FALSE) THEN
  619.   Crash("Dieses Programm ben”tigt eine Maus!");
  620.  END (* IF *);
  621.  bool := InstallGDOSVector();
  622.  IF (bool=FALSE) THEN
  623.   Crash("Es steht nicht genug freier Speicher zur Verfgung!");
  624.  END (* IF *);
  625.  TermProcedure(Terminator);
  626.  InstallRTErrorHandler(RTErrorHandler);
  627.  
  628.  (* ------------------------------------------ *)
  629.  
  630.  MouseOff();
  631. (*
  632.  DrawBorder(15,1,50,50,500,300);
  633. *)
  634.  
  635.  DrawBorder(15,1,0,14,638,460);
  636.  DrawBorder(1,15,1,15,636,458);
  637.  DrawX(15,2,33,636);
  638.  DrawX(1,2,34,636);
  639. (*
  640.  DrawBorder(15,1,1,14,640,18);
  641. *)
  642.  
  643.  titel[0] := "Gadget #1";
  644.  titel[1] := "Gadget #2";
  645.  titel[2] := "Gadget #3";
  646.  
  647.  titel[3] := "Datei";
  648.  titel[4] := "System";
  649.  titel[5] := "Einstellungen";
  650.  
  651.  titel[6] := "Information";
  652.  titel[7] := "Programm starten";
  653.  titel[8] := "Datei l”schen";
  654.  titel[9] := "Datei umbenennen";
  655.  titel[10] := "Netzwerk";
  656.  titel[11] := "šber Programm-Manager";
  657.  titel[12] := "Programm beenden";
  658.  
  659.  titel[15] := "Zeige versteckte Dateien";
  660.  titel[16] := "Zeige Systemdateien";
  661.  
  662.  titel[25] := "Farben";
  663.  titel[26] := "Maus";
  664.  titel[27] := "Signalton";
  665.  titel[28] := "Verzeichnisse";
  666.  
  667.  (*
  668.  titel[5] := "Graphical DOS User Interface - Version 0.01";
  669.  FOR a := 1 TO 15 DO
  670.   PutText(a,10,a+5,ADR(titel[5]));
  671.  END;
  672. *)
  673.  w1 := OpenWindow(ADR(titel[0]),2,3,76,8,WindowFlagSet{memSwap,windowClose,windowDepth});
  674.  w2 := OpenWindow(ADR(titel[1]),7,7,25,11,WindowFlagSet{windowClose,windowDepth,memSwap});
  675.  m1 := AddMenu(w2,2,30,ADR(titel[3]),TRUE);
  676.  AddItem(m1,ADR(titel[6]),FALSE,FALSE,TRUE);
  677.  AddItem(m1,NIL,FALSE,FALSE,FALSE);
  678.  AddItem(m1,ADR(titel[7]),FALSE,FALSE,TRUE);
  679.  AddItem(m1,ADR(titel[8]),FALSE,FALSE,TRUE);
  680.  AddItem(m1,ADR(titel[9]),FALSE,FALSE,TRUE);
  681.  AddItem(m1,NIL,FALSE,FALSE,FALSE);
  682.  AddItem(m1,ADR(titel[10]),FALSE,FALSE,FALSE);
  683.  AddItem(m1,NIL,FALSE,FALSE,FALSE);
  684.  AddItem(m1,ADR(titel[11]),FALSE,FALSE,TRUE);
  685.  AddItem(m1,ADR(titel[12]),FALSE,FALSE,TRUE);
  686.  m1 := AddMenu(w2,15,30,ADR(titel[4]),TRUE);
  687.  AddItem(m1,ADR(titel[15]),TRUE,TRUE,TRUE);
  688.  AddItem(m1,ADR(titel[16]),TRUE,TRUE,TRUE);
  689.  m1 := AddMenu(w2,30,30,ADR(titel[5]),TRUE);
  690.  AddItem(m1,ADR(titel[25]),FALSE,FALSE,TRUE);
  691.  AddItem(m1,ADR(titel[26]),FALSE,FALSE,TRUE);
  692.  AddItem(m1,ADR(titel[27]),FALSE,FALSE,TRUE);
  693.  AddItem(m1,ADR(titel[28]),FALSE,FALSE,TRUE);
  694.  
  695.  AddBoolGadget(w2,2,3,15,1,ADR(titel[0]),1000);
  696.  AddBoolGadget(w2,2,6,15,1,ADR(titel[1]),2000);
  697.  AddBoolGadget(w2,2,9,15,1,ADR(titel[2]),3000);
  698.  w3 := OpenWindow(ADR(titel[2]),10,10,25,10,WindowFlagSet{windowClose,windowDepth,memSwap});
  699. (*
  700.  w4 := OpenWindow(ADR(titel[3]),13,13,25,9,WindowFlagSet{windowClose,windowDepth,memSwap});
  701.  w5 := OpenWindow(ADR(titel[4]),16,16,25,8,WindowFlagSet{windowClose,windowDepth,memSwap});
  702.  LockWindow(w5);
  703. *)
  704.  
  705.  MouseOn();
  706.  
  707.  REPEAT
  708.   msg := DesktopManager(MessageClassSet{keyHit,gadgetUp,menuPick,activateWindow});
  709.  UNTIL (msg^.window=w1);
  710.  
  711.  
  712.  WaitForKey;
  713. (*
  714.  Crash("Fehlermeldungs-Requester-Test");
  715. *)
  716.  
  717. (*
  718.  IF (w1 # NIL) THEN CloseWindow(w1); END;
  719.  WaitForKey;
  720.  IF (w3 # NIL) THEN CloseWindow(w3); END;
  721.  WaitForKey;
  722.  IF (w4 # NIL) THEN CloseWindow(w4); END;
  723.  WaitForKey;
  724.  IF (w2 # NIL) THEN CloseWindow(w2); END;
  725.  WaitForKey;
  726.  IF (w5 # NIL) THEN CloseWindow(w5); END;
  727.  WaitForKey;
  728. *)
  729.  
  730.  (* ------------------------------------------ *)
  731.  
  732.  UninstallRTErrorHandler;
  733.  Terminate(0);
  734.  
  735. END GDOS.
  736.